home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 January / Macworld (1998-01).dmg / Shareware World / Comms & Internet / HTML mode 2.0 etc. / htmlEngine.tcl < prev    next >
Encoding:
Text File  |  1997-09-22  |  56.9 KB  |  1,810 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  HTML mode - tools for editing HTML documents
  4.  # 
  5.  #  FILE: "htmlEngine.tcl"
  6.  #                                    created: 96-04-29 21.31.28 
  7.  #                                last update: 97-09-17 19.34.12 
  8.  #  Author: Johan Linde
  9.  #  E-mail: <jl@theophys.kth.se>
  10.  #     www: <http://bach.theophys.kth.se/~jl/Alpha.html>
  11.  #  
  12.  # Version: 2.0
  13.  # 
  14.  # Copyright 1996, 1997 by Johan Linde
  15.  #  
  16.  # This software may be used freely, and distributed freely, as long as the 
  17.  # receiver is not obligated in any way by receiving it.
  18.  #  
  19.  # If you make improvements to this file, please share them!
  20.  # 
  21.  # ###################################################################
  22.  ##
  23.  
  24. proc htmlEngine.tcl {} {}
  25.  
  26. proc htmlIsUnsignedInteger {str1} {
  27.     return [regexp {^[0-9]+$} [string trim $str1]]
  28. }
  29.  
  30. proc htmlIsPositiveInteger {str1} {
  31.     return [expr ([htmlIsUnsignedInteger $str1] && ![regexp {^0+$} [string trim $str1]])]
  32. }
  33.  
  34. proc htmlIsInteger {str} {
  35.     return [regexp {^-?[0-9]+$} [string trim $str]]
  36. }
  37.  
  38. # Checks to see if the current window is empty, except for whitespace.
  39. proc htmlIsEmptyFile {} {
  40.     return [htmlIsWhite [getText 0 [maxPos]]]
  41. }
  42.  
  43. # Removes all tags from a string.
  44. proc htmlTagStrip {str} {
  45.     regsub -all {<[^<>]*>} $str "" str
  46.     return $str
  47. }
  48.  
  49. # Quoting of strings for meta tags.
  50. proc htmlQuote {str} {
  51.     regsub -all "#" $str {#;} str
  52.     regsub -all "\"" $str {#qt;} str
  53.     regsub -all "<" $str {#lt;} str
  54.     regsub -all ">" $str {#gt;} str
  55.     return $str
  56. }
  57.  
  58. proc htmlUnQuote {str} {
  59.     regsub -all {#qt;} $str "\"" str
  60.     regsub -all {#lt;} $str "<" str
  61.     regsub -all {#gt;} $str ">" str
  62.     regsub -all {#;} $str "#" str
  63.     return $str
  64. }
  65.  
  66. # ◊◊◊◊ Change below for new system §8 ◊◊◊◊ #
  67. proc htmlRedraw {} {
  68.     eval sizeWin [lrange [getGeometry] 2 end]
  69. }
  70. # ◊◊◊◊ end changing for new system §8 ◊◊◊◊ #
  71.  
  72. # Find the version number of a program.
  73. # Returns 0 if any problem.
  74. proc htmlGetVersion {sig} {
  75.     set vers [objectProperty 'MACS' vers "obj {want:type(file), seld:$sig, form:fcrt, from:'null'()}"]
  76.     if {[regexp {vers\(«([0-9]+)} $vers dum vers]} {
  77.         return [string trimleft [string range $vers 0 1].[string range $vers 2 3] 0]
  78.     }
  79.     return 0
  80. }
  81.  
  82. # Checks if the current position is inside the container ELEM.
  83. proc htmlIsInContainer {elem} {
  84.     set exp1 "<${elem}(\[ \t\r\]+\[^<>\]*>|>)"
  85.     set exp2 "</${elem}>"
  86.     set pos [getPos]
  87.     if {![catch {search -s -f 0 -r 1 -i 1 -m 0 $exp1 $pos} res1] && $pos > [lindex $res1 1] &&
  88.     ([catch {search -s -f 0 -r 1 -i 1 -m 0 $exp2 $pos} res2] || 
  89.     [lindex $res1 0] > [lindex $res2 0])} {
  90.         return 1
  91.     }
  92.     return 0
  93. }
  94.  
  95. # Checks if an element is an INPUT elements.
  96. proc htmlIsInputElement {elem} {
  97.     global htmlElemProc
  98.     if {[lsearch -exact {TEXT PASSWORD CHECKBOX BUTTON RADIO IMAGE HIDDEN FILE SUBMIT RESET} $elem] >= 0 ||
  99.     [info exists htmlElemProc($elem)] && [lindex $htmlElemProc($elem) 0] == "htmlBuildInputElem"} {
  100.         return 1
  101.     }
  102.     return 0
  103. }
  104.  
  105. proc htmlCommentStrings {} {
  106.     if {[htmlIsInContainer SCRIPT] || [htmlIsInContainer STYLE]} {
  107.         return [list "/* " " */"]
  108.     } else {
  109.         return [list "<!-- " " -->"]
  110.     }
  111. }
  112.  
  113. # Create a string for URL mapping in Big Brother.
  114. proc htmlURLmap {} {
  115.     global HTMLmodeVars
  116.     set urlmap {}
  117.     foreach hp $HTMLmodeVars(homePages) {
  118.         set fld "[htmlURLescape [lindex $hp 0] 1]/"
  119.         regsub -all ":" $fld "/" fld
  120.         set url [htmlURLescape "[lindex $hp 1][lindex $hp 2]"]
  121.         lappend urlmap "Msta:“$url”, Mend:“file:///$fld”"
  122.         append urlmap ","
  123.     }
  124.     set urlmap [string trimright $urlmap ","]
  125.     return $urlmap
  126. }
  127.  
  128. # Checks if an app is running.
  129. proc htmlCheckRunning {sig} {
  130.     foreach    p [processes] {
  131.         if {[lindex $p 1] == $sig } {
  132.             return 1
  133.         }
  134.     }
  135.     return 0
  136. }
  137.  
  138. # Makes a line for browser error window.
  139. proc htmlBrwsErr {fil l lnum ln text path} {
  140.     return "$fil[format "%$l\s" ""]; Line $lnum:[format "%$ln\s" ""]$text\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t∞$path\r"
  141. }
  142.  
  143. proc htmlSetWin {mode} {
  144.     insertColorEscape 0 1
  145.     insertColorEscape [nextLineStart [nextLineStart 0]] 0
  146.     newMode $mode
  147.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  148.     setWinInfo dirty 0
  149.     setWinInfo read-only 1
  150.     scrollUpLine; scrollUpLine
  151. }
  152.     
  153. proc htmlIsTextFile {fil cmd} {
  154.     if {[getFileType $fil] != "TEXT"} {
  155.         $cmd "[file tail $fil] is not a text file."
  156.         return 0
  157.     }
  158.     return 1
  159. }
  160.  
  161. proc htmlAllSaved {msg} {
  162.     set dirty 0
  163.     foreach w [winNames] {
  164.         getWinInfo -w $w arr
  165.         if {$arr(dirty)} {set dirty 1; break}
  166.     }
  167.     if {$dirty} {
  168.         set yn [eval [concat askyesno $msg]]
  169.         if {$yn == "yes"} {saveAll}
  170.         return $yn
  171.     }
  172.     return yes
  173. }
  174.  
  175. proc htmlIsThereAHomePage {} {
  176.     global HTMLmodeVars    
  177.     if {![llength $HTMLmodeVars(homePages)]} {
  178.         alertnote "You must set a home page folder."
  179.         htmlHomePages
  180.     }
  181.     return [llength $HTMLmodeVars(homePages)]
  182. }
  183.  
  184. proc htmlWhichHomePage {msg} {
  185.     global HTMLmodeVars
  186.     foreach hp $HTMLmodeVars(homePages) {
  187.         lappend hplist "[lindex $hp 1][lindex $hp 2]"
  188.     }
  189.     if {[catch {listpick -p "Select home page to $msg." $hplist} hp] || ![string length $hp]} {error ""}
  190.     set home [lindex $HTMLmodeVars(homePages) [lsearch -exact $hplist $hp]]
  191.     if {![file exists [lindex $home 0]] || ![file isdirectory [lindex $home 0]]} {
  192.         alertnote "Can't find the folder for [lindex $home 1][lindex $home 2]"
  193.         error ""
  194.     }
  195.     return $home
  196. }
  197.  
  198. # Determines in which home page folder a URL points to.
  199. # If none, return empty string.
  200. proc htmlInWhichHomePage {url} {
  201.     global HTMLmodeVars
  202.     foreach p $HTMLmodeVars(homePages) {
  203.         if {[string match "[lindex $p 1][lindex $p 2]*" $url]} {return [lindex $p 0]}
  204.     }
  205.     return ""
  206. }
  207.  
  208. # Checks if a folder contains a home page folder or an include folder as a subfolder.
  209. proc htmlContainHpFolder {folder} {
  210.     global HTMLmodeVars
  211.     foreach p $HTMLmodeVars(homePages) {
  212.         foreach i {0 4} {
  213.             if {[llength $p] == $i} {continue}
  214.             if {[string match "$folder:*" "[lindex $p $i]:"] && "[lindex $p $i]:" != "$folder:"} {
  215.                 return 1
  216.             }
  217.         }
  218.     }
  219.     return 0
  220. }
  221.  
  222. # Asks for a folder and checks that it is not an alias.
  223. proc htmlGetDir {prompt} {
  224.     while {1} {
  225.         if {[file isdirectory [set folder [get_directory -p $prompt]]]} {
  226.             break
  227.         } else {
  228.             alertnote "Sorry! Cannot resolve aliases."
  229.         }
  230.     }
  231.     return [string trimright $folder :]
  232. }
  233.  
  234. proc htmlNotYet {} {
  235.     alertnote "Not yet, but coming soon."
  236. }
  237.  
  238. proc htmlDisabled {} {
  239.     alertnote "Disabled function!"
  240.     error "Disabled function!"
  241. }
  242.  
  243. proc htmlSetCase {elem} {
  244.     global HTMLmodeVars 
  245.     if {$HTMLmodeVars(useLowerCase)} { 
  246.         return [string tolower $elem] 
  247.     } else {
  248.         return [string toupper $elem] 
  249.     }
  250. }
  251.  
  252.  
  253. # Returns a list of all attributes used in any HTML element.
  254. proc htmlGetAllAttrs {} {
  255.     global htmlElemAttrOptional1 htmlElemAttrRequired1 htmlElemEventHandler1
  256.     
  257.     foreach elem [array names htmlElemAttrOptional1] {
  258.         if {[info exists htmlElemAttrRequired1($elem)]} {
  259.             append allHTMLattrs " " $htmlElemAttrRequired1($elem)
  260.         }
  261.         append allHTMLattrs " " $htmlElemAttrOptional1($elem)
  262.         if {[info exists htmlElemEventHandler1($elem)]} {
  263.             append allHTMLattrs " " [string toupper $htmlElemEventHandler1($elem)]
  264.         }
  265.     }
  266.     return $allHTMLattrs
  267. }
  268.  
  269.  
  270. # Snatch the current selection into htmlCurSel, set flag whether there is one
  271. proc htmlGetSel {} {
  272.     global htmlCurSel htmlIsSel
  273.     set htmlCurSel [string trim [getSelect]]
  274.     set htmlIsSel [string length $htmlCurSel]
  275. }
  276.  
  277.  
  278. # Insert one or two carriage returns at the insertion point if any
  279. # character preceding the insertion point (on the same line)
  280. # is a non-whitespace character.
  281. proc htmlOpenCR {indent {extrablankline 0}} {
  282.     set end [getPos]
  283.     set start [lineStart $end]
  284.     set text [getText $start $end]
  285.     if {![htmlIsWhite $text]} {
  286.         set r "\r$indent"
  287.         if {$extrablankline} {append r "\r$indent"}
  288.         return $r
  289.     } elseif {$start > 0 } { 
  290.         set prevstart [lineStart [expr $start - 1 ]]
  291.         set text [getText $prevstart [expr $start - 1]]
  292.         if {![htmlIsWhite $text] && $extrablankline} {
  293.             return "\r$indent"
  294.         } else { 
  295.             return [htmlFirstLineIndent $indent]
  296.         }
  297.     } else {
  298.         return [htmlFirstLineIndent $indent]
  299.     }
  300. }
  301.  
  302. # Insert a carriage return at the insertion point if any
  303. # character following the insertion point (on the same line)
  304. # is a non-whitespace character.
  305. proc htmlCloseCR {indent {start ""}} {
  306.     if {$start == ""} {set start [selEnd]}
  307.     if {![htmlIsWhite [getText $start [nextLineStart $start]]]} {
  308.         return "\r$indent"
  309.     }
  310. }
  311.  
  312. # Insert up to two carriage return at the insertion point depending
  313. # on how many blank lines there are after the insertion point.
  314. proc htmlCloseCR2 {indent pos} {
  315.     set blank1 [htmlIsWhite [getText $pos [nextLineStart $pos]]]
  316.     set blank2 [htmlIsWhite [getText $pos [nextLineStart [nextLineStart $pos]]]]
  317.     if {!$blank1} {
  318.         return "\r$indent\r$indent"
  319.     } elseif {!$blank2} {
  320.         return "\r$indent"
  321.     }    
  322. }
  323.  
  324. proc HTMLelectricSemi {} {
  325.     global HTMLmodeVars
  326.     if [isSelection] { deleteSelection }
  327.     if {!$HTMLmodeVars(electricSemi) || (![htmlIsInContainer SCRIPT] && ![htmlIsInContainer STYLE])} {
  328.         insertText ";"
  329.         return
  330.     }
  331.     set pos [getPos]
  332.     set start [lineStart $pos]
  333.     set text [getText $start $pos]
  334.     
  335.     if {[string first "for" $text] != "-1"} {
  336.         set lefts 0
  337.         set rights 0
  338.         set len [string length $text]
  339.         for {set i 0} {$i < $len} {incr i} {
  340.             case [string index $text $i] in {
  341.                 "("    { incr lefts }
  342.                 ")"    { incr rights }
  343.             }
  344.         }
  345.         if {$lefts != $rights} {
  346.             insertText ";"
  347.             return
  348.         }
  349.     }
  350.     
  351.     insertText ";\r" [htmlGetIndent $pos]
  352. }
  353.  
  354. #===============================================================================
  355. # Tab key
  356. #===============================================================================
  357.  
  358. # Set up tab mark mechanism.
  359. proc htmlTabGoto {directionIndicator} {
  360.     set searchResult [search -s -n -f $directionIndicator -m 0 -i 1 -r 0 {•} [getPos]]
  361.     if {![llength $searchResult] || [lindex $searchResult 0] >= [maxPos]} {
  362.         beep
  363.         message "Tab mark not found."
  364.         return 0
  365.     } else {
  366.         goto [lindex $searchResult 0]
  367.         return 1
  368.     }
  369. }
  370.  
  371. proc htmlNextTabMark {} {
  372.     if {[htmlTabGoto 1]} {deleteChar}
  373. }
  374.  
  375. proc htmlPreviousTabMark {} {
  376.     if {[htmlTabGoto 0]} {deleteChar}
  377. }
  378.  
  379. # ◊◊◊◊ Change below for new system §18 ◊◊◊◊ #
  380.  
  381. # If current position is inside a tag, complete the tag or attributes
  382. # being written.
  383. proc htmlWordComplete {} {
  384.     global htmlPackageToUse htmlElemAttrOptional1 htmlElemAttrOptional3 HTMLmodeVars htmlColorAttr
  385.     global basicColors htmluserColors htmlSpecColor htmlURLAttr htmlSpecURL HTMLmodeVars
  386.     global htmlSpecWindow htmlWindowAttr
  387.     
  388.     if {[htmlIsInContainer SCRIPT]} {wordCompletion; return}
  389.     if {[htmlIsInContainer STYLE]} {cssWordComplete; return}
  390.     
  391.     set pos [getPos]
  392.     set allTags [array names htmlElemAttrOptional${htmlPackageToUse}]
  393.  
  394.     # Find the tag.
  395.     if {[catch {search -s -f 0 -r 1 -m 0 {<[^ \t\r<>]+} [expr $pos - 1]} left]} {wordCompletion; return}
  396.     if {![catch {search -s -f 0 -r 0 -m 0 {>} [expr $pos - 1]} right]
  397.     && [lindex $right 1] > [lindex $left 1] && [lindex $right 0] < $pos} {wordCompletion; return}
  398.     set tag [string toupper [string range [eval getText $left] 1 end]]
  399.     if {$tag == "LI"} {
  400.         set ltype [htmlFindList]
  401.         if {$ltype == "UL"} {
  402.             set tag "LI IN UL"
  403.         } elseif {$ltype == "OL"} {
  404.             set tag "LI IN OL"
  405.         }            
  406.     }
  407.     set tagBegin [expr [lindex $left 0] + 1]
  408.     set tagEnd [lindex $left 1]
  409.     # opening or closing tag
  410.     set opening 1
  411.     if {[string index $tag 0] == "/"} {
  412.         set tag    [string range $tag 1 end]
  413.         incr tagBegin 1
  414.         set opening 0
  415.     }
  416.     # inside < and > or just right of < ?
  417.     if {![catch {search -s -f 1 -r 0 -m 0 {>} $pos} r1] && 
  418.     ![catch {search -s -f 1 -r 0 -m 0 {<} $pos} l1] &&
  419.     [lindex $r1 0] < [lindex $l1 0]} {
  420.         set inside 1
  421.     } else {
  422.         set inside 0
  423.     }
  424.     
  425.     # Are we typing the tag or an attribute?
  426.     if {$tagEnd == $pos} {
  427.         # tag
  428.         set matches ""
  429.         foreach t $allTags {
  430.             if {[string match "$tag*" $t]} {lappend matches $t}
  431.         }
  432.         if {![llength $matches]} {
  433.             select $tagBegin $tagEnd
  434.         } else {
  435.             set newTag [largestPrefix $matches]
  436.             if {!$inside} {
  437.                 append newTag >
  438.                 if {$HTMLmodeVars(useTabMarks) && ($opening || [llength $matches] > 1)} {append newTag •}
  439.             }
  440.             replaceText $tagBegin $tagEnd [htmlSetCase $newTag]
  441.             if {!$inside && ($opening || [llength $matches] > 1)} {goto [expr [getPos] - 1 - $HTMLmodeVars(useTabMarks)]}
  442.         }
  443.     } else {
  444.         # Attribute
  445.         if {!$opening} {return}
  446.         # are we between quotes to type the attribute value?
  447.         if {![catch {search -s -f 0 -r 1 -m 0 {=\"[^\"]*\"} [expr $pos - 1]} pos5] &&  [lindex $pos5 0] > $tagBegin &&
  448.         [lindex $pos5 1] > $pos} {
  449.             if {![catch {search -s -f 0 -r 1 -m 0 {[ \t\r\"][^ \t\r\"=]+=\"[^\"]*\"} [expr $pos - 1]} attPos] && [lindex $attPos 0] > $tagBegin && 
  450.             [lindex $attPos 1] > $pos} {
  451.                 set txt [getText [expr [lindex $attPos 0] + 1] [lindex $attPos 1]]
  452.                 regexp {([^=]+=)\"([^\"]*)\"} $txt dum attr val
  453.                 set attr [string toupper $attr]
  454.                 set begin [expr [lindex $attPos 0] + 2 + [string length $attr]]
  455.                 set end [expr [lindex $attPos 1] - 1]
  456.                 set choices [htmlGetChoices $tag]
  457.                 if {[lsearch $choices "$attr*"] < 0} {
  458.                     if {[lsearch -exact [concat [htmlGetRequired $tag] [htmlGetOptional $tag 1]] $attr] < 0} {wordCompletion; return}
  459.                     set isChoice 0
  460.                     if {([lsearch -exact $htmlColorAttr $attr] >= 0 && [lsearch -exact $htmlSpecColor "${tag}!=[string trimright $attr =]"] < 0) || \
  461.                     [lsearch -exact $htmlSpecColor "${tag}=[string trimright $attr =]"] >= 0} {
  462.                         set choices [concat $basicColors [array names htmluserColors]]
  463.                     } elseif {([lsearch -exact $htmlURLAttr $attr] >= 0 && [lsearch -exact $htmlSpecURL "${tag}!=[string trimright $attr =]"] < 0) || \
  464.                     [lsearch -exact $htmlSpecURL "${tag}=[string trimright $attr =]"] >= 0} {
  465.                         set choices $HTMLmodeVars(URLs)
  466.                     } elseif {([lsearch -exact $htmlWindowAttr $attr] >= 0 && [lsearch -exact $htmlSpecWindow "${tag}!=[string trimright $attr =]"] < 0) || \
  467.                     [lsearch -exact $htmlSpecWindow "${tag}=[string trimright $attr =]"] >= 0} {
  468.                         set choices [concat _self _blank _top _parent $HTMLmodeVars(windows)]
  469.                     } else {
  470.                         wordCompletion; return
  471.                     }
  472.                 } else {
  473.                     set val [string toupper $val]
  474.                     set isChoice 1
  475.                 }
  476.                 
  477.                 set matches ""
  478.                 foreach c $choices {
  479.                     if {$isChoice && [string match "${attr}$val*" $c]} {
  480.                         lappend matches [string range $c [string length $attr] end]
  481.                     } elseif {!$isChoice && [string match "$val*" $c]} {
  482.                         lappend matches $c
  483.                     }
  484.                 }
  485.                 if {![llength $matches]} {
  486.                     select $begin $end
  487.                 } else {
  488.                     set newval [largestPrefix $matches]
  489.                     if {$isChoice} {set newval [htmlSetCase $newval]}
  490.                     replaceText $begin $end $newval
  491.                 }
  492.                 return
  493.             }
  494.         }
  495.  
  496.         # we are typing the attribute itself.
  497.         set addSpace 0
  498.         if {[set c [lookAt [getPos]]] != " " && $c != ">"} {set addSpace 1} 
  499.         backwardWord
  500.         set attrBegin [getPos]
  501.         set attrEnd $pos
  502.         set attr [string toupper [getText $attrBegin $attrEnd]]
  503.         set eventAtts [htmlGetEvent $tag]
  504.         set allAttrs [concat [htmlGetRequired $tag] [htmlGetOptional $tag 1] [string toupper $eventAtts]]
  505.         set matches ""
  506.         foreach t $allAttrs {
  507.             if {[string match "$attr*" $t]} {lappend matches $t}
  508.         }
  509.         if {![llength $matches]} {
  510.             select $attrBegin $attrEnd
  511.         } else {
  512.             if {[lookAt [expr $attrBegin - 1]] == "\""} {set newAttr " "}
  513.             append newAttr [largestPrefix $matches]
  514.             if {[set i [lsearch [string toupper $eventAtts] "$newAttr*"]] >= 0} {
  515.                 set newAttr [string range [lindex $eventAtts $i] 0 [expr [string length $newAttr] - 1]]
  516.             } else {
  517.                 set newAttr [htmlSetCase $newAttr]
  518.             }
  519.             set backup 1
  520.             if {[llength $matches] == 1} {
  521.                 if {[regexp {=} $newAttr]} {
  522.                     append newAttr "\"\""
  523.                     if {$HTMLmodeVars(useTabMarks)} {append newAttr •}
  524.                 }
  525.                 if {$addSpace} {append newAttr " "; set backup 2} 
  526.             }
  527.             replaceText $attrBegin $attrEnd $newAttr
  528.             if {[llength $matches] == 1 && [regexp {=} $newAttr]} {goto [expr [getPos] - $backup - $HTMLmodeVars(useTabMarks)]}
  529.         }
  530.     }
  531. }
  532.  
  533. # ◊◊◊◊ end changing for new system §18 ◊◊◊◊ #
  534.  
  535. #===============================================================================
  536. # Building tags, including element attributes
  537. #===============================================================================
  538.  
  539. # A couple of functions to get element variables from the right package.
  540. proc htmlGetSomeAttrs {item type num1 pkg} {
  541.     global htmlElem${type}$num1  htmlElem${type}3
  542.     if {[catch {set atts [set htmlElem${type}${pkg}($item)]}]} { 
  543.         if {$type == "AttrMore"} {
  544.             set atts 0
  545.         } else {
  546.             set atts {} 
  547.         }
  548.     }
  549.     return $atts
  550. }    
  551.  
  552. proc htmlGetRequired {item} {
  553.     global htmlPackageToUse
  554.     return [htmlGetSomeAttrs $item AttrRequired 1 $htmlPackageToUse]
  555. }
  556.  
  557. proc htmlGetOptional {item {all 0}} {
  558.     global htmlPackageToUse HTMLmodeVars htmlElemHideNetscape htmlElemHideIE
  559.     set attrs [htmlGetSomeAttrs $item AttrOptional 1 $htmlPackageToUse]
  560.     if {$all} {return $attrs}
  561.     if {$HTMLmodeVars(hideStyleAttrs)} {
  562.         foreach a {CLASS= ID= STYLE=} {
  563.             if {[set w [lsearch -exact $attrs $a]] >= 0} {
  564.                 set attrs [lreplace $attrs $w $w]
  565.             }
  566.         }
  567.     }
  568.     if {$htmlPackageToUse == 3} {return $attrs}
  569.     foreach b {Netscape IE} {
  570.         if {[set HTMLmodeVars(hide${b})] && [info exists htmlElemHide${b}($item)]} {
  571.             foreach a [set htmlElemHide${b}($item)] {
  572.                 set attrs [lreplace $attrs [set i [lsearch -exact $attrs $a]] $i]
  573.             }
  574.         }
  575.     }
  576.     return $attrs
  577. }
  578.  
  579. proc htmlGetNumber {item} {
  580.     global htmlPackageToUse
  581.     return [htmlGetSomeAttrs $item AttrNumber 1 $htmlPackageToUse]
  582. }
  583.  
  584.  
  585. proc htmlGetChoices {item} {
  586.     global htmlPackageToUse
  587.     return [htmlGetSomeAttrs $item AttrChoices 1 $htmlPackageToUse]
  588. }
  589.  
  590. proc htmlGetEvent {item} {
  591.     global htmlPackageToUse
  592.     return [htmlGetSomeAttrs $item EventHandler 1 $htmlPackageToUse]
  593. }
  594.  
  595. proc htmlGetUsed {item {reqatts ""} {optatts ""}} {
  596.     global htmlPackageToUse
  597.     if {$htmlPackageToUse == 1} {
  598.         set num ""
  599.     } else {
  600.         set num 3
  601.     }
  602.     set useatts [htmlGetSomeAttrs $item AttrUsed "" $num]
  603.     if {$reqatts == ""} {set reqatts [htmlGetRequired $item]}
  604.     if {$optatts == ""} {set optatts [htmlGetOptional $item]}
  605.     # Add missing required attributes.
  606.     foreach a $reqatts {
  607.         if {[lsearch -exact $useatts $a] < 0} {
  608.             set useatts "$a $useatts"
  609.         }
  610.     }
  611.     # Remove extra attributes
  612.     foreach a $useatts {
  613.         if {[lsearch -exact $reqatts $a] < 0 && [lsearch -exact $optatts $a] < 0} {
  614.             set where [lsearch -exact $useatts $a]
  615.             set useatts [lreplace $useatts $where $where]
  616.         }
  617.     }
  618.     return $useatts
  619. }
  620.  
  621. proc htmlGetAttrMore {item} {
  622.     global htmlPackageToUse
  623.     if {$htmlPackageToUse == 1} {
  624.         set num ""
  625.     } else {
  626.         set num 3
  627.     }
  628.     return [htmlGetSomeAttrs $item AttrMore "" $num]
  629. }
  630.  
  631. proc htmlOpenElem {elem {used ""} {pos -1}} {
  632.     global HTMLmodeVars 
  633.     if {$HTMLmodeVars(useBigWindows)} {
  634.         return [htmlOpenElemWindow $elem $used $pos]
  635.     } else {
  636.         return [htmlOpenElemStatusBar $elem $used $pos]
  637.     }
  638. }
  639.  
  640. # Opening or only tag of an element - include attributes
  641. # Big window with all attributes.
  642. # Return empty string if user clicks "Cancel".
  643.  
  644. proc htmlOpenElemWindow {elem used wrPos {values ""} {addNotUsed 0} {addHidden 0} {absPos ""}} {
  645.     global HTMLmodeVars  htmlColorName htmlElemEventHandler1
  646.     global  htmluserColors basicColors htmlPackageToUse
  647.     global htmlURLAttr htmlColorAttr  htmlWindowAttr
  648.     global htmlSpecURL htmlSpecColor htmlSpecWindow
  649.     
  650.     set URLs $HTMLmodeVars(URLs)
  651.     set Windows {_self _top _parent _blank}
  652.     if {[llength $HTMLmodeVars(windows)]} {append Windows " - " $HTMLmodeVars(windows)}
  653.     
  654. # put users colours first
  655.     set htmlColors [lsort [array names htmluserColors]]
  656.      append htmlColors " - " $basicColors
  657.  
  658.     if {![string length $used]} {set used $elem}
  659.     set elem [string toupper $elem]
  660.     set used [string toupper $used]
  661.     
  662.     # get variables for the element
  663.     set reqatts [htmlGetRequired $used]
  664.     set numatts [htmlGetNumber $used]
  665.     set optatts [htmlGetOptional $used]
  666.     set alloptatts [htmlGetOptional $used 1]
  667.     set choiceatts [htmlGetChoices $used]
  668.     set notUsedAtts ""
  669.     if {$HTMLmodeVars(useAttsApplyToDialogs)} {
  670.         set allatts [htmlGetUsed $used $reqatts $optatts]
  671.         foreach a $optatts {
  672.             if {[lsearch -exact $allatts $a] < 0} {
  673.                 lappend notUsedAtts $a
  674.             }
  675.         }
  676.     } else {
  677.         set allatts [concat $reqatts $optatts]
  678.     }
  679.     set reallyAllAtts [concat $reqatts $alloptatts]
  680.     foreach a $alloptatts {
  681.         if {[lsearch -exact $optatts $a] < 0} {
  682.             lappend hiddenAtts $a
  683.         }
  684.     }
  685.     if {$addNotUsed} {
  686.         append allatts " $notUsedAtts"
  687.         set notUsedAtts ""
  688.     }
  689.     if {$addHidden} {append allatts " $hiddenAtts"}
  690.     # optionally include event handlers
  691.     if {$HTMLmodeVars(inclEventHandler)} {
  692.         set eventatts [htmlGetEvent $used]
  693.         append allatts " " $eventatts
  694.     } else {
  695.         set eventatts ""
  696.     }
  697.  
  698.     # if there are attributes to ask about, do so
  699.  
  700.     set text "<"
  701.     append text  [htmlSetCase $elem]
  702.     if {![llength $allatts]} {return "$text>"}
  703.  
  704.     set maxHeight [expr [lindex [getMainDevice] 3] - 115]
  705.     set thisPage "Page 1"
  706.  
  707.     set widthIndex -1
  708.     set heightIndex -1
  709.     if {$absPos == ""} {set absPos [getPos]}
  710.     # build window with attributes 
  711.     set invalidInput 1
  712.     while {$invalidInput} {
  713.         # wrapping
  714.         set htmlWrapPos [expr $wrPos == -1 ? [lindex [posToRowCol [getPos]] 1] : $wrPos]
  715.         incr htmlWrapPos [expr [string length $text] + 1]
  716.         while {1} {
  717.             if {$used == "LI IN UL" || $used == "LI IN OL"} {
  718.                 set pr LI
  719.             } else {
  720.                 set pr $used
  721.             }
  722.             set box1 "-t {Attributes for $pr} 120 10 450 25"
  723.             set box2 "-t {Attributes for $pr} 120 10 450 25"
  724.             set box3 "-t {Attributes for $pr} 120 10 450 25"
  725.             set page 1
  726.             set attrtypes {}
  727.             set fileIndex ""
  728.             set colorIndex ""
  729.             set wpos 10
  730.             if {[string length $reqatts]} {
  731.                 lappend box$page -p 120 30 270 31 -t {Required attributes} 10 35 200 50
  732.                 set hpos 60
  733.             } else {
  734.                 set hpos 30
  735.             }
  736.             set attrIndex 2
  737.             for {set i 0} {$i < [llength $allatts]} {incr i} {
  738.                 set attr [lindex $allatts $i]
  739.                 if {$i == [llength $reqatts]} {
  740.                     if {$wpos > 20} { incr hpos 20 }
  741.                     lappend box$page -p 120 $hpos 270 [expr $hpos + 1] \
  742.                     -t {Optional attributes} 10 [expr $hpos + 5] 200 [expr $hpos + 20]
  743.                     set wpos 10
  744.                     incr hpos 30
  745.                 }
  746.                 set a2 [string trimright $attr =]
  747.                 if {[string index $attr [expr [string length $attr] - 1]] != "="}  { 
  748.                     # Flag
  749.                     if {[expr $hpos + 20] > $maxHeight && $wpos < 20 && $page < 3} {
  750.                         incr page
  751.                         set hpos 40
  752.                     }
  753.                     lappend box$page -c $attr [lindex $values $attrIndex] $wpos $hpos [expr $wpos + 100] [expr $hpos + 15]
  754.                     incr attrIndex 
  755.                     if {$wpos > 20} { 
  756.                         incr hpos 25
  757.                         set wpos 10
  758.                     } else {
  759.                         set wpos 230
  760.                     }
  761.                     lappend attrtypes flag
  762.                 } elseif {([lsearch -exact $htmlURLAttr $attr] >= 0 && [lsearch -exact $htmlSpecURL "${used}!=$a2"] < 0) || \
  763.                 [lsearch -exact $htmlSpecURL "${used}=$a2"] >= 0} { 
  764.                     # URL
  765.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}
  766.                     if {[expr $hpos + 45] > $maxHeight && $page < 3} {
  767.                         incr page
  768.                         set hpos 40
  769.                     }
  770.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  771.                     -e [lindex $values $attrIndex] 120 $hpos 450 [expr $hpos + 15] \
  772.                     -m [concat [list [lindex $values [expr $attrIndex + 1]] {No value}] $URLs] \
  773.                     120 [expr $hpos + 25] 450 [expr $hpos + 35] \
  774.                     -b "File…" 10 [expr $hpos + 20] 70 [expr $hpos + 40]
  775.                     incr attrIndex 3
  776.                     incr hpos 50
  777.                     lappend attrtypes url
  778.                     lappend fileIndex [expr $attrIndex - 1]
  779.                 } elseif {([lsearch -exact $htmlColorAttr $attr] >= 0 && [lsearch -exact $htmlSpecColor "${used}!=$a2"] < 0) || \
  780.                 [lsearch -exact $htmlSpecColor "${used}=$a2"] >= 0} { 
  781.                     # Color attribute
  782.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  783.                     if {[expr $hpos + 25] > $maxHeight && $page < 3} {
  784.                         incr page
  785.                         set hpos 40
  786.                     }
  787.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  788.                     -e [lindex $values $attrIndex] 120 $hpos 190 [expr $hpos + 15] \
  789.                     -m [concat [list [lindex $values [expr $attrIndex + 1]] {No value}] $htmlColors] \
  790.                     200 $hpos 340 [expr $hpos + 15] \
  791.                     -b "New Color…" 350 $hpos 450 [expr $hpos + 20]
  792.                     incr attrIndex 3
  793.                     incr hpos 30
  794.                     lappend attrtypes color
  795.                     lappend colorIndex [expr $attrIndex - 1]
  796.                 } elseif {([lsearch -exact $htmlWindowAttr $attr] >= 0 && [lsearch -exact $htmlSpecWindow "${used}!=$a2"] < 0) || \
  797.                 [lsearch -exact $htmlSpecWindow "${used}=$a2"] >= 0} { 
  798.                     # Window attribute
  799.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  800.                     if {[expr $hpos + 25] > $maxHeight && $page < 3} {
  801.                         incr page
  802.                         set hpos 40
  803.                     }
  804.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  805.                     -e [lindex $values $attrIndex] 120 $hpos 240 [expr $hpos + 15] \
  806.                     -m [concat [list [lindex $values [expr $attrIndex + 1]] {No value}] \
  807.                     $Windows] \
  808.                     250 $hpos 440 [expr $hpos + 15]
  809.                     incr attrIndex 2
  810.                     incr hpos 30
  811.                     lappend attrtypes window
  812.                 } elseif {[lsearch $numatts "${attr}*"] >= 0} { 
  813.                     # Number
  814.                     if {[expr $hpos + 20] > $maxHeight && $wpos < 20 && $page < 3} {
  815.                         incr page
  816.                         set hpos 40
  817.                     }
  818.                     if {$attr == "WIDTH="} {set widthIndex $attrIndex}
  819.                     if {$attr == "HEIGHT="} {set heightIndex $attrIndex}
  820.                     lappend box$page -t $attr $wpos $hpos [expr $wpos + 100] [expr $hpos + 15] \
  821.                     -e [lindex $values $attrIndex] [expr $wpos + 110] $hpos [expr $wpos + 150] [expr $hpos + 15]
  822.                     incr attrIndex 
  823.                     if {$wpos > 20} { 
  824.                         incr hpos 25
  825.                         set wpos 10
  826.                     } else {
  827.                         set wpos 230
  828.                     }
  829.                     lappend attrtypes number
  830.                 } elseif {[lsearch $choiceatts "${attr}*"] >= 0} { 
  831.                     # Choices
  832.                     if {[expr $hpos + 20] > $maxHeight && $wpos < 20 && $page < 3} {
  833.                         incr page
  834.                         set hpos 40
  835.                     }
  836.                     set matches {}
  837.                     foreach w $choiceatts {
  838.                         if {[string match "${attr}*" $w]} {
  839.                             lappend matches  [string range $w [string length $attr] end]
  840.                         }    
  841.                     }
  842.                     lappend box$page -t $attr $wpos $hpos [expr $wpos + 100] [expr $hpos + 15] \
  843.                     -m [concat [list [lindex $values $attrIndex] {No value}] $matches] \
  844.                     [expr $wpos + 110] $hpos [expr $wpos + 205] [expr $hpos + 15]
  845.                     incr attrIndex 
  846.                     if {$wpos > 20} { 
  847.                         incr hpos 25 
  848.                         set wpos 10
  849.                     } else {
  850.                         set wpos 230
  851.                     }    
  852.                     lappend attrtypes choices
  853.                 } else {
  854.                     # Any other
  855.                     if {$wpos > 20} { incr hpos 25 ; set wpos 10}                    
  856.                     if {[expr $hpos + 20] > $maxHeight && $page < 3} {
  857.                         incr page
  858.                         set hpos 40
  859.                     }
  860.                     lappend box$page -t $attr 10 $hpos 120 [expr $hpos + 15] \
  861.                     -e [lindex $values $attrIndex] 120 $hpos 450 [expr $hpos + 15] 
  862.                     incr attrIndex
  863.                     incr hpos 25
  864.                     lappend attrtypes any
  865.                 }
  866.             }
  867.             if {$wpos > 20} { incr hpos 25 }
  868.             
  869.             if {$page == 1} {
  870.                 set box $box1
  871.             } elseif {$page == 2} {
  872.                 set hpos $maxHeight
  873.                 set box " -m \{\{$thisPage\} \{Page 1\} \{Page 2\}\} 10 10 85 30 -n \{Page 1\} $box1 -n \{Page 2\} $box2"
  874.             } elseif {$page == 3} {
  875.                 set hpos $maxHeight
  876.                 set box " -m \{\{$thisPage\} \{Page 1\} \{Page 2\} \{Page 3\}\} 10 10 85 30 -n \{Page 1\} $box1 -n \{Page 2\} $box2 -n \{Page 3\} $box3"
  877.             }
  878.             # Add More button if hidden attrs
  879.             set moreButton 0
  880.             if {[llength $reallyAllAtts] > [llength $allatts]} {
  881.                 set box " -b More… 200 [expr $hpos + 20] 265 [expr $hpos + 40] $box"
  882.                 set moreButton 1
  883.             }
  884.             set values [eval [concat dialog -w 460 -h [expr $hpos + 50] \
  885.             -b OK 20 [expr $hpos + 20]  85 [expr $hpos + 40] \
  886.             -b Cancel 110 [expr $hpos + 20] 175 [expr $hpos + 40] $box]]
  887.             
  888.             # More button clicked?
  889.             if {[llength $reallyAllAtts] > [llength $allatts] && [lindex $values 2]} {
  890.                 if {[llength $notUsedAtts]} {
  891.                     append allatts " $notUsedAtts"
  892.                     set notUsedAtts ""
  893.                 } else {
  894.                     append allatts " $hiddenAtts"
  895.                 }
  896.             }
  897.             # If more button...
  898.             if {$moreButton} {
  899.                 set values [lreplace $values 2 2]
  900.             }
  901.             # If two pages...
  902.             if {$page > 1} {
  903.                 set thisPage [lindex $values 2]
  904.                 set values [lreplace $values 2 2]
  905.             }
  906.             # OK button clicked?
  907.             if {[lindex $values 0] } { break }
  908.             # Cancel button clicked?
  909.             if {[lindex $values 1] } { return}
  910.             # File button clicked?
  911.             foreach fl $fileIndex {
  912.                 if {[lindex $values $fl] && [string length [set newFile [htmlGetFile]]]} {
  913.                     set URLs $HTMLmodeVars(URLs)
  914.                     set values [lreplace $values [expr $fl - 1] [expr $fl - 1] [lindex $newFile 0]]
  915.                     if {$used == "IMG" && $fl == 4 && [llength [set widhei [lindex $newFile 1]]]} {
  916.                         if {$widthIndex >= 0} {set values [lreplace $values $widthIndex $widthIndex [lindex $widhei 0]]}
  917.                         if {$heightIndex >= 0} {set values [lreplace $values $heightIndex $heightIndex [lindex $widhei 1]]}
  918.                     }
  919.                 }
  920.             }
  921.             # Color button clicked?
  922.             foreach cl $colorIndex {
  923.                 if {[lindex $values $cl] && [string length [set newcolor [htmlAddNewColor]]]} {
  924.                     set htmlColors [concat [list $newcolor] $htmlColors]
  925.                     set values [lreplace $values [expr $cl - 1] [expr $cl - 1] "$newcolor"]
  926.                 }
  927.             }
  928.         }
  929.         
  930.  
  931.         # put everything together
  932.         set attrtext ""
  933.         set errtext ""
  934.  
  935.         set j 2
  936.         for {set i 0} {$i < [llength $attrtypes]} {incr i} {
  937.             set attr [lindex $allatts $i]                
  938.             switch [lindex $attrtypes $i] {
  939.                 url {
  940.                     set texturl [string trim [lindex $values $j]]
  941.                     set menuurl [lindex $values [expr $j + 1]]
  942.                     if {[string length $texturl]} {        
  943.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes [htmlURLescape2 $texturl]]"]
  944.                         htmlAddToCache URLs $texturl
  945.                     } elseif {$menuurl != "No value"} {
  946.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes [htmlURLescape2 $menuurl]]"] 
  947.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  948.                         lappend errtext "$attr required."
  949.                     }
  950.                     incr j 3
  951.                 }
  952.                 color {
  953.                     set colortxt [lindex $values $j]
  954.                     set colorval [lindex $values [expr $j + 1]]
  955.                     if {[string length $colortxt]} {
  956.                         set col [htmlCheckColorNumber $colortxt]
  957.                                  if {$col == 0} {
  958.                                      lappend errtext "$attr: $colortxt is not a valid color number."
  959.                         } else {    
  960.                             append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $col]"]
  961.                         }
  962.                     } elseif {$colorval != "No value"} {
  963.                         # Users own color?
  964.                         if {[info exists htmluserColors($colorval)]} {
  965.                             set colornum $htmluserColors($colorval)
  966.                         }
  967.                         # Predefined color?
  968.                         if {[info exists htmlColorName($colorval)]} {
  969.                             set colornum $htmlColorName($colorval)
  970.                         }
  971.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $colornum]"]
  972.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  973.                         lappend errtext "$attr required."
  974.                     }
  975.                     incr j 3
  976.                 }
  977.                 window {
  978.                     set textwin [string trim [lindex $values $j]]
  979.                     set menuwin [lindex $values [expr $j + 1]]
  980.                     if {[string length $textwin]} {        
  981.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $textwin]"]
  982.                         htmlAddToCache windows $textwin
  983.                     } elseif {$menuwin != "No value"} {
  984.                         append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $menuwin]"]
  985.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  986.                         lappend errtext "$attr required."
  987.                     }
  988.                     incr j 2
  989.                 }
  990.                 number {
  991.                     set numval [string trim [lindex $values $j]]
  992.                     if {[string length $numval]} {
  993.                         if {[htmlCheckAttrNumber $used $attr $numval] == 1} {        
  994.                             append attrtext [htmlWrapTag "[htmlSetCase $attr][htmlAddQuotes $numval]"]
  995.                         } else {
  996.                             lappend errtext "$attr: [htmlCheckAttrNumber $used $attr $numval]"
  997.                         }
  998.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  999.                         lappend errtext "$attr required."
  1000.                     }
  1001.                     incr j
  1002.                 }
  1003.                 choices {
  1004.                     set choiceval [lindex $values $j]
  1005.                     if {$choiceval != "No value"} {        
  1006.                         set qchoice [htmlAddQuotes $choiceval]
  1007.                         if {($used != "LI IN OL" && $used != "OL") || $attr != "TYPE="} {
  1008.                             set qchoice [htmlSetCase $qchoice]
  1009.                         }
  1010.                         append attrtext [htmlWrapTag "[htmlSetCase $attr]$qchoice"]
  1011.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  1012.                         lappend errtext "$attr required."
  1013.                     }
  1014.                     incr j
  1015.                 }
  1016.                 any {
  1017.                     set anyval [lindex $values $j]
  1018.                     # Trim only if it's only spaces.
  1019.                     if {[string trim $anyval] == ""} {set anyval ""}
  1020.                     if {[string length $anyval]} {
  1021.                         htmlOpenExtraThings $used $attr $anyval
  1022.                         if {[lsearch -exact $eventatts $attr] < 0} {
  1023.                             set attr [htmlSetCase $attr]
  1024.                         }
  1025.                         append attrtext [htmlWrapTag "$attr[htmlAddQuotes $anyval]"]
  1026.                     } elseif {[lsearch -exact $reqatts $attr] >= 0} {
  1027.                         lappend errtext "$attr required."
  1028.                     }
  1029.                     incr j
  1030.                 }
  1031.                 flag {
  1032.                     set flagval [lindex $values $j]
  1033.                     if {$flagval} {        
  1034.                         append attrtext [htmlWrapTag [htmlSetCase $attr]]
  1035.                     }
  1036.                     incr j
  1037.                 }
  1038.             }
  1039.         }    
  1040.         # If everything is OK, add the attribute text to text.
  1041.         if {![llength $errtext]} {
  1042.             append text $attrtext
  1043.             set invalidInput 0
  1044.         } else {
  1045.             # Put up alert with the error text.
  1046.             htmlErrorWindow "Invalid input for $used" $errtext
  1047.         }
  1048.         # Some tests that input is ok.
  1049.         if {!$invalidInput} {set invalidInput [htmlFontBaseTest $text alertnote]}
  1050.         if {!$invalidInput && $elem == "A" && [set invalidInput [htmlATest $text alertnote]]} {
  1051.             set text "<[htmlSetCase A]"
  1052.         }
  1053.         if {!$invalidInput && $elem == "FRAMESET" && [set invalidInput [htmlFramesetTest $text alertnote]]} {
  1054.             set text "<[htmlSetCase FRAMESET]"
  1055.         }
  1056.         if {!$invalidInput && $elem == "SPACER" && [set invalidInput [htmlSpacerTest $text alertnote]]} {
  1057.             set text "<[htmlSetCase SPACER]"
  1058.         }
  1059.         if {!$invalidInput && $elem == "AREA" && [set invalidInput [htmlAreaTest $text alertnote]]} {
  1060.             set text "<[htmlSetCase AREA]"
  1061.         }
  1062.     }
  1063.     
  1064.     if {[string length $text] } {append text ">"}
  1065.     
  1066.     return ${text}
  1067. }
  1068.  
  1069. proc htmlWrapTag {toadd} {
  1070.     global fillColumn HTMLmodeVars
  1071.     upvar htmlWrapPos wrpos absPos ap
  1072.     if {!$HTMLmodeVars(wordWrap)} {return " $toadd"}
  1073.     incr wrpos [string length $toadd]
  1074.     if {$wrpos > $fillColumn} {
  1075.         set ind [htmlGetIndent $ap]
  1076.         set wrpos [string length "$ind$toadd"]
  1077.         return "\r$ind$toadd"
  1078.     } else {
  1079.         return " $toadd"
  1080.     }
  1081. }
  1082.  
  1083. # these two require at least one of several optional attributes
  1084. proc htmlFontBaseTest {text cmd} {
  1085.     if {[string toupper $text] == "<FONT" || [string toupper $text] == "<BASEFONT" ||
  1086.     [string toupper $text] == "<BASE" || [string toupper $text] == "<SPAN"} {  
  1087.         eval {$cmd "At least one of the attributes is required."}
  1088.         return 1
  1089.     }
  1090.     return 0
  1091. }
  1092.  
  1093. # HREF or NAME must be used for A.
  1094. proc htmlATest {text cmd} {
  1095.     if {![regexp -nocase {href=} $text] && ![regexp -nocase {name=} $text]} {
  1096.         eval {$cmd "At least one of the attributes HREF and NAME must be used."}
  1097.         return 1
  1098.     }
  1099.     return 0
  1100. }
  1101.  
  1102. # ROWS or COLS must be used for FRAMESET
  1103. proc htmlFramesetTest {text cmd} {
  1104.     if {![regexp -nocase {rows=} $text] && ![regexp -nocase {cols=} $text]} {
  1105.         eval {$cmd "At least one of the attributes ROWS and COLS must be used."}
  1106.         return 1
  1107.     }
  1108.     return 0
  1109. }
  1110.  
  1111. # Some checks for SPACER.
  1112. proc htmlSpacerTest {text cmd} {
  1113.         set horver [regexp -nocase {type=\"(horizontal|vertical)\"} $text]
  1114.         set wh [regexp -nocase {width=|height=} $text]
  1115.         set sz [regexp -nocase {size=} $text]
  1116.         set al [regexp -nocase {align=} $text]
  1117.         set invalidInput 1
  1118.         if {$horver && ($wh || $al)} {
  1119.             eval {$cmd "WIDTH, HEIGHT and ALIGN should only be used when TYPE=BLOCK."}
  1120.         } elseif {!$horver && $sz} {
  1121.             eval {$cmd "SIZE should only be used when TYPE=HORIZONTAL or VERTICAL."}
  1122.         } elseif {$horver && !$sz} {
  1123.             eval {$cmd "SIZE is required when TYPE=HORIZONTAL or VERTICAL."}
  1124.         } elseif {!$horver && !$wh} {
  1125.             eval {$cmd "WIDTH or HEIGHT is required when TYPE=BLOCK."}
  1126.         } else {
  1127.             set invalidInput 0
  1128.         }
  1129.         return $invalidInput
  1130. }
  1131.  
  1132. # For AREA, either HREF or NOHREF must be used, but not both.
  1133. proc htmlAreaTest {text cmd} {
  1134.     set hasHref [regexp -nocase {href=} $text]
  1135.     set hasNohref [regexp -nocase {nohref} $text]
  1136.     set hasCoords [regexp -nocase {coords=} $text]
  1137.     set shapeDefault [regexp -nocase {shape=\"default\"} $text]
  1138.     set invalidInput 0
  1139.     if {($hasHref && $hasNohref) || (!$hasHref && !$hasNohref)} {
  1140.         eval {$cmd "One of the attributes HREF and NOHREF must be used, but not both."}
  1141.         set invalidInput 1
  1142.     } elseif {!$hasCoords && !$shapeDefault} {
  1143.         eval {$cmd "COORDS= is required if SHAPE≠DEFAULT"}
  1144.         set invalidInput 1
  1145.     }
  1146.     return $invalidInput
  1147. }
  1148.  
  1149. # Adds a NAME= value to cache.
  1150. proc htmlOpenExtraThings {elem attr val} {
  1151.     if {[lsearch -exact {A MAP} $elem] >= 0 && $attr == "NAME="} {
  1152.         htmlAddToCache URLs "#$val"
  1153.     }
  1154.     if {$elem == "FRAME" && $attr == "NAME="} {
  1155.         htmlAddToCache windows $val
  1156.     }
  1157. }
  1158.  
  1159.  
  1160. # Check if a input is a valid number for the element attribute.
  1161. # Returns 1 if it is, otherwise returns an error message.
  1162. proc htmlCheckAttrNumber {item attr number} {
  1163.     
  1164.     set attrNumbers [htmlGetNumber $item]
  1165.     set numind [lsearch $attrNumbers "${attr}*"]
  1166.     set numstr [string range [lindex $attrNumbers $numind] [string length $attr] end]
  1167.     regexp {^[-i0-9]+} $numstr minvalue
  1168.     set numstr [string range $numstr [expr [string length $minvalue] + 1] end]
  1169.     regexp {^[-i0-9]+} $numstr maxvalue
  1170.     set procent [string range $numstr [expr [string length $numstr] - 1] end]
  1171.     if {$procent == "%"} {
  1172.         set procerr " or percentage"
  1173.     } else {
  1174.         set procerr ""
  1175.     }
  1176.     if {$minvalue == "-i"} {
  1177.         set errtext "An integer"
  1178.     } elseif {$maxvalue == "i"} {
  1179.         set errtext "A number $minvalue or greater"
  1180.     } else {
  1181.         set errtext "A number in the range $minvalue to $maxvalue"
  1182.     }
  1183.     if {$item == "FONT"} { append errtext " or -6 to +6"}
  1184.     append errtext  "$procerr expected." 
  1185.     # Is percent allowed?
  1186.     if {[string index $number [expr [string length $number] - 1]] == "%" } {
  1187.         set number [string range $number 0 [expr [string length $number] - 2]]
  1188.         if {$procent != "%"} {return $errtext}
  1189.     }
  1190.     # FONT can take values -6 - +6. Special case.
  1191.     if {$item == "FONT" && [regexp {^(\+|-)[1-6]$} $number]} { return 1}
  1192.     # Is input a number?
  1193.     if {![regexp {^-?[0-9]+$} $number]} {return $errtext}
  1194.     # Is input in the valid range?
  1195.     if {( $maxvalue != "i" && $number > $maxvalue ) || ( $minvalue != "-i" && $number < $minvalue ) } {
  1196.         return $errtext
  1197.     }    
  1198.     return 1 
  1199. }
  1200.  
  1201.  
  1202. # Add quotes to attribute
  1203. proc htmlAddQuotes {v} {
  1204.  
  1205.     if {[string range $v 0 0] != "\""} {set v  "\"$v"}
  1206.      set vlen [expr [string length $v] - 1]
  1207.     if {[string range $v $vlen $vlen] !="\""} {append v "\""}
  1208.     return $v
  1209. }
  1210.  
  1211.  
  1212. # Splits an attribute into its name and value and remove quotes.
  1213. proc htmlRemoveQuotes {attrStr} {
  1214.     # Is it a flag?
  1215.     if {![string match "*=*" $attrStr]} {return [string toupper $attrStr]}
  1216.     
  1217.     set attr [string range $attrStr 0 [string first "=" $attrStr]]
  1218.     # Get the attribute value.
  1219.     set attrVal [string range $attrStr [expr [string first "=" $attrStr] + 1] end]
  1220.     
  1221.     return [list $attr [string trim $attrVal \"]]
  1222. }
  1223.  
  1224. # Returns a list of the attributes not used for the tag at the current position.
  1225. proc htmlGetAttributes {} {
  1226.     set pos [getPos]
  1227.     if {[catch {search -s -f 0 -r 1 -m 0 {<[^<>]+>} $pos} res] || [lindex $res 1] < $pos} {
  1228.         message "Current position is not at a tag."
  1229.         return
  1230.     }
  1231.     set tag [string trim [lindex [set all [string toupper [eval getText $res]]] 0] "<>"]
  1232.     if {$tag == "LI"} {
  1233.         set ltype [htmlFindList]
  1234.         if {$ltype == "UL"} {
  1235.             set tag "LI IN UL"
  1236.         } elseif {$ltype == "OL"} {
  1237.             set tag "LI IN OL"
  1238.         }            
  1239.     }
  1240.     # All INPUT elements are defined differently. Must extract TYPE.
  1241.     if {$tag == "INPUT"} {
  1242.         if {![regexp { TYPE=\"?([^ \t\r\"]+)\"?} $all dum tag]} {
  1243.             message "INPUT element without a TYPE attribute."
  1244.             return
  1245.         } 
  1246.     }
  1247.     set ret ""
  1248.     foreach a [concat [htmlGetRequired $tag] [htmlGetOptional $tag 1] [htmlGetEvent $tag]] {
  1249.         set exp "\[ \t\r\n\]+${a}"
  1250.         if {![regexp -nocase $exp $all]} {
  1251.             lappend ret $a
  1252.         }
  1253.     }
  1254.     if {$ret == ""} {message "No attributes."}
  1255.     return $ret
  1256. }
  1257.  
  1258. # Inserts an attribute in a tag at the current position.
  1259. proc htmlInsertAttributes {{attrList ""}} {
  1260.     global HTMLmodeVars fillColumn
  1261.     set useMarks $HTMLmodeVars(useTabMarks)
  1262.     if {$attrList == "" && ([set l [htmlGetAttributes]] == "" ||
  1263.     [catch {listpick -p "Select attributes" -l $l} attrList] || $attrList == "") } {return}
  1264.     foreach attr $attrList {
  1265.         set epos [expr [lindex [search -s -f 0 -r 1 -m 0 {<[^<>]+>} [getPos]] 1] - 1]
  1266.         if {[expr [lindex [posToRowCol $epos] 1] + [string length $attr]] > $fillColumn && $HTMLmodeVars(wordWrap)} {
  1267.             set text "\r[htmlGetIndent $epos]"
  1268.         } else {
  1269.             set text " "
  1270.         }
  1271.         append text $attr
  1272.         if {[string match "*=" $attr]} {
  1273.             append text "\"\""
  1274.             if {$useMarks} {append text •}        
  1275.         }
  1276.         set x [expr $epos - 3]
  1277.         if {[string match "*•" [set etxt [getText $x $epos]]]} {
  1278.             set p [expr $x + 1]
  1279.             if {$useMarks} {
  1280.                 if {[string match "*=" $attr]} {
  1281.                     set text [string range $text 0 [expr [string length $text] - 3]]•\"•
  1282.                 } else {
  1283.                     append text •
  1284.                 }
  1285.             }
  1286.             replaceText [expr $p + 1] $epos $text
  1287.         } else {
  1288.             goto $epos
  1289.             insertText $text
  1290.             if {[regexp {=} $text]} {goto [expr + [getPos] - 1 - $useMarks]}
  1291.         }
  1292.     }
  1293. }
  1294.  
  1295. #===============================================================================
  1296. # Element build routines
  1297. #===============================================================================
  1298.  
  1299. # Closing tag of an element
  1300. proc htmlCloseElem {theElem} {
  1301.     return "</[htmlSetCase $theElem]>"
  1302. }
  1303.  
  1304.  
  1305. proc htmlTag {str} {
  1306.     global htmlElemProc
  1307.     set elem [lindex $str 1]
  1308.     if {[htmlIsInContainer STYLE]} {
  1309.         if {[htmlIsInputElement $elem]} {set elem INPUT}
  1310.         replaceText [getPos] [selEnd] $elem
  1311.     } elseif {[info exists htmlElemProc($elem)]} {
  1312.         eval $htmlElemProc($elem)
  1313.     } else {
  1314.         eval $str
  1315.     }
  1316. }
  1317.  
  1318. # Build elements with only a opening tag.
  1319. proc htmlBuildOpening {ftype {begCR 0} {endCR 0} {attr ""}} {
  1320.     set text1 ""
  1321.     set indent [htmlGetIndent [getPos]]
  1322.     if {$begCR} { 
  1323.         set text1 [htmlOpenCR $indent]
  1324.     }
  1325.     set text [htmlOpenElem $ftype $attr]
  1326.     if {![string length $text]} {return}
  1327.     if {$endCR} {
  1328.         append text [htmlCloseCR $indent]
  1329.     }
  1330.     insertText $text1 $text
  1331. }
  1332.  
  1333.     
  1334. # This is used for almost all containers
  1335. proc htmlBuildElem {ftype {attr ""}} {
  1336.     global HTMLmodeVars htmlCurSel htmlIsSel
  1337.  
  1338.     if {![string length [set text [htmlOpenElem $ftype $attr]]]} {return}
  1339.     htmlGetSel
  1340.     append text $htmlCurSel
  1341.     set currpos [expr [getPos] + [string length $text]]
  1342.     append text [htmlCloseElem $ftype]
  1343.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•"}
  1344.     if {$htmlIsSel} {
  1345.         replaceText [getPos] [selEnd] $text
  1346.     } else {
  1347.         insertText $text
  1348.         goto $currpos
  1349.     }
  1350. }
  1351.  
  1352. # This is used for elements that should be surrounded by newlines
  1353. proc htmlBuildCRElem {ftype {extrablankline 0} {attr ""}} {
  1354.     global htmlCurSel htmlIsSel HTMLmodeVars
  1355.  
  1356.     if {![string length [set text2 [htmlOpenElem $ftype $attr 0]]]} {return}
  1357.     set indent [htmlFindNextIndent]
  1358.     set text [htmlOpenCR $indent $extrablankline]
  1359.     append text $text2
  1360.     htmlGetSel
  1361.     append text $htmlCurSel
  1362.     set currpos [expr [getPos] + [string length $text]]
  1363.     append text [htmlCloseElem $ftype]
  1364.     if {$extrablankline} {
  1365.         set cr2 [htmlCloseCR2 $indent [selEnd]]
  1366.     } else {
  1367.         set cr2 [htmlCloseCR $indent]
  1368.     }
  1369.     append text $cr2
  1370.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•"}
  1371.     if {$htmlIsSel} { deleteSelection }
  1372.     insertText $text
  1373.     if {!$htmlIsSel} {
  1374.         goto $currpos
  1375.     }
  1376. }
  1377.  
  1378. # This is used for elements that should be surrounded by empty lines
  1379. proc htmlBuildCR2Elem {ftype {attr ""}} {
  1380.     global HTMLmodeVars htmlCurSel htmlIsSel
  1381.     
  1382.     htmlGetSel
  1383. # Check if user has skipped an attribute which can't be skipped.
  1384.     if {![string length [set text2 [htmlOpenElem $ftype $attr 0]]]} {return}
  1385.     set indent [htmlFindNextIndent]
  1386.     set text [htmlOpenCR $indent 1]
  1387.     append text $text2
  1388.     if {[info exists HTMLmodeVars(indent${ftype})] && $HTMLmodeVars(indent${ftype})} {
  1389.         regsub -all "\r" $htmlCurSel "\r\t" htmlCurSel
  1390.         set exindent "\t"
  1391.     } else {
  1392.         set exindent ""
  1393.     }
  1394.     if {$htmlIsSel || ($ftype != "SCRIPT" && $ftype != "STYLE")} {
  1395.         append text "\r${indent}${exindent}$htmlCurSel"
  1396.     } else {
  1397.         append text "\r${indent}<!-- /* Hide content from old browsers */\r${indent}"
  1398.     }
  1399.     set currpos [expr [getPos] + [string length $text]]
  1400.     append text \r$indent
  1401.     set pre(SCRIPT) "//"; set pre(STYLE) "/*"; set post(SCRIPT) ""; set post(STYLE) "*/"
  1402.     if {!$htmlIsSel && ($ftype == "SCRIPT" || $ftype == "STYLE")} {append text "$pre($ftype) end hiding content from old browsers $post($ftype) -->\r$indent"}
  1403.     append text [htmlCloseElem $ftype]
  1404.     append text [htmlCloseCR2 $indent [selEnd]]
  1405.     if {!$htmlIsSel && $HTMLmodeVars(useTabMarks)} {append text "•"}
  1406.     if {$htmlIsSel} { deleteSelection }
  1407.     insertText $text
  1408.     if {!$htmlIsSel}    {
  1409.         goto $currpos
  1410.     }
  1411. }
  1412.  
  1413. # Determines which list the current position is inside.
  1414. proc htmlFindList {} {    
  1415.     set listType ""
  1416.     foreach l [list UL OL DIR MENU] {
  1417.         set ex "<${l}(\[ \\t\\r\]+\[^>\]*>|>)"
  1418.         set listOpening [search -s -f 0 -i 1 -r 1 -m 0 -n $ex [getPos]]
  1419.         set ex2 </$l>
  1420.         set listClosing [search -s -f 0 -i 1 -r 1 -m 0 -n $ex2 [getPos]]
  1421.         # Search until a single list opening is found.
  1422.         while {[string length $listOpening] && [string length $listClosing] &&
  1423.         [lindex $listClosing 0] > [lindex $listOpening 0]} {
  1424.             set listOpening [search -s -f 0 -i 1 -r 1 -m 0 -n $ex [expr [lindex $listOpening 0] - 1]]
  1425.             set listClosing [search -s -f 0 -i 1 -r 1 -m 0 -n $ex2 [expr [lindex $listClosing 0] - 1]]
  1426.         }
  1427.         if {[string length $listOpening]} {
  1428.             lappend listType "$listOpening $l"
  1429.         }
  1430.     }
  1431.     set ltype [lindex [lindex $listType 0] 2]
  1432.     set lnum [lindex [lindex $listType 0] 0]
  1433.     for {set i 1} {$i < [llength $listType]} {incr i} {
  1434.         if {[lindex [lindex $listType $i] 0] > $lnum} {
  1435.             set ltype [lindex [lindex $listType $i] 2]
  1436.             set lnum [lindex [lindex $listType $i] 0]
  1437.         }
  1438.     }
  1439.     return $ltype
  1440. }
  1441.  
  1442.  
  1443. # Choose an item from Use Attributes menu.
  1444. proc htmlChooseUseAttr {} {
  1445.     global htmlPackageToUse htmlElemAttrOptional1 htmlElemAttrOptional3
  1446.     foreach a [array names htmlElemAttrOptional$htmlPackageToUse] {
  1447.         if {[llength [set htmlElemAttrOptional${htmlPackageToUse}($a)]]} {lappend htmlPossibleToUse $a}
  1448.     }
  1449.     if {![catch {listpick -p "Choose HTML element" [lsort $htmlPossibleToUse]} elem] &&
  1450.     $elem != ""} {htmlUseAttributes $elem}
  1451. }
  1452.  
  1453. # Customize list of attributes which get asked about
  1454. proc htmlUseAttributes {item} {
  1455.     global HTMLmodeVars htmlPackageToUse modifiedVars
  1456.     global htmlElemAttrUsed htmlElemAttrUsed3
  1457.     global htmlElemAttrMore htmlElemAttrMore3
  1458.     
  1459.     set reqattrs [htmlGetRequired $item]
  1460.     set askformore [htmlGetAttrMore $item]
  1461.     set optatts [htmlGetOptional $item 1]
  1462.     set used [htmlGetUsed $item $reqattrs $optatts]
  1463.     set attrnumber [llength $optatts]
  1464.     
  1465.     set height [expr 95 + (( $attrnumber - 1) / 3 + 1) * 20]
  1466.     set box "-w 400 -h $height -b OK 20 [expr $height - 30]  85 [expr $height - 10] \
  1467.         -b Cancel 110 [expr $height - 30] 175 [expr $height - 10] \
  1468.         -t {Select the optional attributes you want for $item} 10 10 450 30 "
  1469.  
  1470.     lappend box -t {Ask for more?} 10 [expr $height - 55] 110 [expr $height - 40] \
  1471.         -r Yes $askformore 120 [expr $height - 55] 160 [expr $height - 40] \
  1472.         -r No [expr !$askformore] 180 [expr $height - 55] 220 [expr $height - 40]
  1473.     # see which attributes were used previously
  1474.     set wpos 10 
  1475.     set hpos 35
  1476.     foreach attr $optatts {
  1477.         lappend box -c [string trimright $attr =] [expr ([lsearch -exact $used $attr] >= 0)] $wpos $hpos [expr $wpos + 120] [expr $hpos + 15]
  1478.         set wpos [expr $wpos + 130]
  1479.         if {$wpos > 310} {
  1480.             set wpos 10
  1481.             set hpos [expr $hpos + 20]
  1482.         }
  1483.     }
  1484.     # get the new ones wanted
  1485.     set newatts [eval [concat dialog $box]]
  1486.     set newuse {}
  1487.     if {[lindex $newatts 0]} {
  1488.         for {set i 0} {$i < $attrnumber} {incr i} {
  1489.         if {[lindex $newatts [expr $i + 4]]} {
  1490.                 lappend newuse [lindex $optatts $i]
  1491.             }
  1492.         }
  1493.         set newuse [concat $reqattrs $newuse]
  1494.         if {$htmlPackageToUse == 1} {
  1495.             set num ""
  1496.         } else {
  1497.             set num 3
  1498.         }
  1499.         set htmlElemAttrUsed${num}($item) $newuse
  1500.         addArrDef htmlElemAttrUsed$num $item $newuse
  1501.         set htmlElemAttrMore${num}($item) [lindex $newatts 2]
  1502.         addArrDef htmlElemAttrMore$num $item [lindex $newatts 2]
  1503.     }
  1504. }
  1505.  
  1506. #===============================================================================
  1507. # Indentation
  1508. #===============================================================================
  1509.  
  1510. proc HTMLindentLine {} {
  1511.     
  1512.     if {[htmlIsInContainer STYLE] || [htmlIsInContainer SCRIPT]} {CindentLine; return}
  1513.     if {[htmlIsInContainer PRE]} {return}
  1514.     
  1515.     set previndent [htmlFindIndent]
  1516.     set thisLine [string trimleft [getText [set lstart [lineStart [getPos]]] [set lend [expr [nextLineStart [getPos]] - 1]]]]
  1517.     set thisIndent [htmlGetIndent [getPos]]
  1518.     if {$thisIndent != $previndent} {replaceText $lstart $lend "$previndent$thisLine"}
  1519.  
  1520. }
  1521.  
  1522. # Find the indentation the current line should have.
  1523. proc htmlFindIndent {{pos0 ""}} {
  1524.     global htmlIndentElements HTMLmodeVars
  1525.     set indent ""
  1526.     foreach i $htmlIndentElements {
  1527.         if {$HTMLmodeVars(indent$i)} {lappend indent $i}
  1528.     }
  1529.     # Find previous non-blank line.
  1530.     if {$pos0 == ""} {set pos0 [getPos]}
  1531.     set pos [expr [lineStart $pos0] - 1]
  1532.     while {$pos >= 0 && [regexp {^[ \t]*$} [getText [lineStart $pos] $pos]]} {
  1533.         set pos [expr [lineStart $pos] - 1]
  1534.     }
  1535.     set pos [expr $pos >= 0 ? $pos : 0]
  1536.     # Get indentation on that line.
  1537.     set previndent [htmlGetIndent $pos]
  1538.     # Find last tag on or before that line.
  1539.     if {[catch {search -s -f 0 -m 0 -r 1 {<([^<>]+)>} $pos} tag] || [lindex $tag 1] < [lineStart $pos] ||
  1540.     ( [lindex $tag 0] < [lineStart $pos0] && [lindex $tag 1] > [lineStart $pos0])} {
  1541.         set tag ""
  1542.     } else {
  1543.         set tag [string trim [eval getText $tag] "<>"]
  1544.     }
  1545.     set tag [string toupper [lindex $tag 0]]
  1546.     # Add a tab to indentation?
  1547.     if {[lsearch -exact $indent $tag] >= 0} {
  1548.         append previndent "\t"
  1549.     }
  1550.     # Find last tag on current line.
  1551.     set tag ""
  1552.     set lstart [lineStart $pos0]
  1553.     set lend [expr ([set npos [nextLineStart $pos0]] <= $lstart) ? $lstart : $npos - 1]
  1554.     regexp {<([^<>]+)>} [getText $lstart $lend] dum tag
  1555.     set tag [string toupper [lindex $tag 0]]
  1556.     
  1557.     # Remove a tab from indentation?
  1558.     if {[string index $tag 0] == "/" && [lsearch -exact $indent [string range $tag 1 end]] >= 0} {
  1559.         set previndent [htmlReduceIndent $previndent]
  1560.     }
  1561.     return $previndent 
  1562. }
  1563.  
  1564. # Find the indentation the next line should have.
  1565. proc htmlFindNextIndent {{pos0 ""}} {
  1566.     global HTMLmodeVars htmlIndentElements
  1567.     set indent ""
  1568.     foreach i $htmlIndentElements {
  1569.         if {$HTMLmodeVars(indent$i)} {lappend indent $i}
  1570.     }
  1571.     if {$pos0 == ""} {set pos0 [getPos]}
  1572.     set ind [htmlFindIndent $pos0]
  1573.     # Find last tag before pos0 on current line.
  1574.     set tag ""
  1575.     set lstart [lineStart $pos0]
  1576. #     set lend [expr ([set npos [nextLineStart $pos0]] <= $lstart) ? $lstart : $npos - 1]
  1577.     regexp {<([^<>]+)>} [getText $lstart $pos0] dum tag
  1578.     set tag [string toupper [lindex $tag 0]]
  1579.     # Remove a tab from indentation?
  1580.     if {[lsearch -exact $indent $tag] >= 0} {append ind "\t"}
  1581.     return $ind
  1582. }
  1583.  
  1584. # get the leading whitespace of the current line
  1585. proc htmlGetIndent { pos } {
  1586.     set res [search -s -n -f 1 -r 1 "^\[ \t\]*" [lineStart $pos]]
  1587.     return [htmlIndentConvert [eval getText $res]]
  1588. }
  1589.  
  1590. # convert it to minimal form: tabs then spaces.
  1591. proc htmlIndentConvert {indent} {
  1592.     getWinInfo a
  1593.     set sp [string range "              " 1 $a(tabsize) ]
  1594.     regsub -all $sp $indent "\t" indent
  1595.     regsub -all "\[ \]+\t" $indent "\t" indent
  1596.     return $indent
  1597. }
  1598.  
  1599. # Removes tabsize whitespace.
  1600. proc htmlReduceIndent {indent} {
  1601.     getWinInfo a
  1602.     set sp [string range "              " 1 $a(tabsize) ]
  1603.     regsub -all "\t" $indent $sp indent
  1604.     set indent [string range $indent $a(tabsize) end]
  1605.     regsub -all $sp $indent "\t" indent
  1606.     regsub -all "\[ \]+\t" $indent "\t" indent
  1607.     return $indent
  1608. }
  1609.  
  1610. proc htmlFirstLineIndent {indent} {
  1611.     if {![htmlIsWhite [set text [getText [lineStart [getPos]] [getPos]]]]} {return $indent}
  1612.     set text [htmlIndentConvert $text]
  1613.     return [string range $indent [string length $text] end]
  1614. }
  1615.  
  1616. #===============================================================================
  1617. # Tidy up source
  1618. #===============================================================================
  1619. proc htmlReformatParagraph {} {htmlTidyUp paragraph}
  1620. proc htmlReformatDocument {} {htmlTidyUp document}
  1621.  
  1622. proc htmlTidyUp {where} {
  1623.     global HTMLmodeVars fillColumn htmlElemProc htmlIndentElements
  1624.     message "Reformatting…"
  1625.     set oldfillColumn $fillColumn
  1626.     getWinInfo a
  1627.     set tab $a(tabsize)
  1628.     if {$where == "paragraph"} {
  1629.         if {[isSelection]} {
  1630.             set startPos [getPos]
  1631.             set endPos [selEnd]
  1632.         } else {
  1633.             if {[catch {search -s -f 0 -m 0 -r 1 {^[ \t]*$} [getPos]} sp]} {set sp 0}
  1634.             set startPos [nextLineStart [lindex $sp 1]]
  1635.             if {[catch {search -s -f 1 -m 0 -r 1 {^[ \t]*$} [getPos]} sp]} {set sp "0 [maxPos]"}
  1636.             set endPos [expr [lindex $sp 1] < [maxPos] ? [lindex $sp 1] + 1 : [maxPos]]
  1637.         }
  1638.         set ind [htmlFindIndent $startPos]
  1639.         set fillColumn [expr $oldfillColumn - $tab * [string length $ind]]
  1640.         set cr 2
  1641.     } else {
  1642.         set startPos 0
  1643.         set endPos [maxPos]
  1644.         set ind ""
  1645.         set cr 0
  1646.     }
  1647.     # Remember position
  1648.     set srem [expr [set pos [getPos]] - 20 < $startPos ? $startPos : $pos - 20]
  1649.     set remember_str [quoteExpr2 [getText $srem $pos ]]
  1650.     regsub -all {\?} $remember_str {\\?} remember_str
  1651.     regsub -all "\[ \t\r\]+" $remember_str {[ \t\r]+} remember_str
  1652.     # To handle indentation
  1653.     set indList ""
  1654.     foreach i $htmlIndentElements {
  1655.         if {$HTMLmodeVars(indent$i)} {lappend indList $i}
  1656.     }
  1657.     
  1658.     # These tags should have a blank line before
  1659.     set blBef {TITLE HEAD BODY STYLE H1 H2 H3 H4 H5 H6 P BLOCKQUOTE DIV CENTER PRE MULTICOL OBJECT
  1660.     NOEMBED UL OL DIR MENU DL FORM SELECT TABLE TR FRAMESET NOFRAMES MAP APPLET SCRIPT NOSCRIPT LAYER NOLAYER}
  1661.     # These tags should have a cr before
  1662.     set crBef {/HTML /HEAD /BODY /STYLE /P /BLOCKQUOTE /DIV ADDRESS /CENTER /PRE /MULTICOL HR BASEFONT
  1663.     MARQUEE /OBJECT BGSOUND /NOEMBED /UL /OL /DIR /MENU LI /DL DT /FORM /SELECT OPTION TEXTAREA
  1664.     KEYGEN /TABLE /TR CAPTION COL COLGROUP THEAD TBODY TFOOT /FRAMESET FRAME /NOFRAMES /MAP AREA
  1665.     /APPLET PARAM /SCRIPT /NOSCRIPT /LAYER ILAYER /NOLAYER BASE ISINDEX LINK META !--}
  1666.     # These tags should have a blank line after
  1667.     set blAft {/TITLE /HEAD /BODY /STYLE /H1 /H2 /H3 /H4 /H5 /H6 /P /BLOCKQUOTE /DIV /CENTER /PRE /MULTICOL
  1668.     /OBJECT /NOEMBED /UL /OL /DIR /MENU /DL /FORM /SELECT /TABLE /TR /FRAMESET /NOFRAMES /MAP
  1669.     /APPLET /SCRIPT /NOSCRIPT /LAYER /NOLAYER}
  1670.     # These tags should have a cr after
  1671.     set crAft {HTML /HTML HEAD BODY STYLE P BLOCKQUOTE DIV /ADDRESS CENTER PRE MULTICOL BR HR WBR BASEFONT
  1672.     /MARQUEE OBJECT BGSOUND NOEMBED UL OL DIR MENU /LI DL /DD FORM INPUT SELECT OPTION /TEXTAREA KEYGEN
  1673.     TABLE TR /CAPTION COL COLGROUP THEAD TBODY TFOOT FRAMESET FRAME NOFRAMES MAP AREA APPLET PARAM
  1674.     SCRIPT NOSCRIPT LAYER /ILAYER NOLAYER BASE ISINDEX LINK META !--}
  1675.     # Custom elements
  1676.     foreach c [array names htmlElemProc] {
  1677.         switch [lindex $htmlElemProc($c) 0] {
  1678.             htmlBuildCR2Elem {
  1679.                 lappend blBef $c
  1680.                 lappend crBef /$c
  1681.                 lappend blAft /$c
  1682.                 lappend crAft $c
  1683.             }
  1684.             htmlBuildCRElem {
  1685.                 if {[lindex $htmlElemProc($c) 2] == "1"} {
  1686.                     lappend blBef $c
  1687.                     lappend blAft /$c
  1688.                 } else {
  1689.                     lappend crBef $c
  1690.                     lappend crAft /$c
  1691.                 }
  1692.             }
  1693.             htmlBuildOpening {
  1694.                 if {[lindex $htmlElemProc($c) 2] == "1"} {lappend crBef $c}
  1695.                 if {[lindex $htmlElemProc($c) 3] == "1"} {lappend crAft $c}
  1696.             }
  1697.         }
  1698.     }
  1699.     set all [concat $blBef $blAft $crBef $crAft]
  1700.     set bef [concat $blBef $crBef]
  1701.     set aft [concat $blAft $crAft]
  1702.     set pos $startPos
  1703.     set tmp ""
  1704.     set text ""
  1705.     while {![catch {search -s -f 1 -m 0 -r 1 {(<!--|<[^<>]+>)} $pos} pos1] && [lindex $pos1 1] <= $endPos} {
  1706.         set tag [string toupper [lindex [set wholeTag [string trim [eval getText $pos1] "<>"]] 0]]
  1707.         if {$tag != "!--"} {
  1708.             set w ""
  1709.             set i {0 0}
  1710.             # To avoid line breaks inside attributes
  1711.             while {[regexp -indices {=\"[^ \"]* [^\"]*\"} $wholeTag i]} {
  1712.                 append w [string range $wholeTag 0 [expr [lindex $i 0] - 1]]
  1713.                 regsub -all "\[ \t\r\]+" [string range $wholeTag [lindex $i 0] [lindex $i 1]] "" w1
  1714.                 append w $w1
  1715.                 set wholeTag [string range $wholeTag [expr [lindex $i 1] + 1] end]
  1716.             }
  1717.             set wholeTag $w$wholeTag
  1718.         }
  1719.         append tmp [getText $pos [lindex $pos1 0]]
  1720.         set pos [lindex $pos1 1]            
  1721.         if {[lsearch $all $tag] < 0} {
  1722.             append tmp <$wholeTag>
  1723.             continue
  1724.         }
  1725.         # cr or blank line before tag
  1726.         if {[lsearch $bef $tag] >= 0} {
  1727.             regsub -all "\[ \t\]*\r\[ \t\]*" [string trim $tmp] " " tmp
  1728.             set tmp [string trimright [breakIntoLines $tmp]]
  1729.             regsub -all "" $tmp " " tmp
  1730.             regsub -all "\r" $tmp "\r$ind" tmp
  1731.             if {![htmlIsWhite $tmp]} {set cr 0; append text $ind}
  1732.             append text $tmp
  1733.             set ble [lsearch $blBef $tag]
  1734.             if {$cr == 1 && $ble >= 0 && ([string index $tag 0] != "/" || [lsearch $indList [string range $tag 1 end]] < 0)} {
  1735.                 append text $ind
  1736.             }
  1737.             if {$cr == 0} {
  1738.                 append text \r
  1739.                 incr cr
  1740.                 if {$cr == 1 && $ble >= 0} {append text $ind}
  1741.             }
  1742.             if {$ble >= 0 && $cr < 2} {append text \r; incr cr}
  1743.             set tmp <$wholeTag>
  1744.             # Take care of comments separately
  1745.             if {$tag == "!--"} {
  1746.                 set tmp "<!--"
  1747.                 if {[catch {search -s -f 1 -m 0 -r 1 -i 1 -- "-->" $pos} pos2]} {set pos2 "0 $endPos"}
  1748.                 append text $ind$tmp[getText $pos [set pos [lindex $pos2 1]]]
  1749.                 set tmp ""
  1750.                 set cr 0
  1751.             }
  1752.             # The contents of these tags should be left untouched
  1753.             if {[lsearch {SCRIPT STYLE PRE} $tag] >= 0} {
  1754.                 set tag /$tag
  1755.                 regsub -all "" $tmp " " tmp
  1756.                 if {[catch {search -s -f 1 -m 0 -r 1 -i 1 "<$tag>" $pos} pos2]} {set pos2 "0 $endPos"}
  1757.                 append text $ind$tmp[getText $pos [set pos [lindex $pos2 1]]]
  1758.                 set tmp ""
  1759.                 set cr 0
  1760.             }
  1761.         } else {
  1762.             append tmp <$wholeTag>
  1763.         }
  1764.         # cr or blank line after tag
  1765.         if {[lsearch $aft $tag] >= 0} {
  1766.             if {[string index $tag 0] == "/" && [lsearch $indList [string range $tag 1 end]] >= 0} {
  1767.                 set ind [string range $ind 1 end]
  1768.                 set fillColumn [expr $oldfillColumn - $tab * [string length $ind]]
  1769.             }
  1770.             regsub -all "\[ \t\]*\r\[ \t\]*" [string trim $tmp] " " tmp
  1771.             set tmp [string trimright [breakIntoLines $tmp]]
  1772.             regsub -all "" $tmp " " tmp
  1773.             regsub -all "\r" $tmp "\r$ind" tmp
  1774.             if {![htmlIsWhite $tmp]} {set cr 0; append text $ind}
  1775.             append text $tmp
  1776.             set bla [lsearch $blAft $tag]
  1777.             if {[lsearch $indList $tag] >= 0} {
  1778.                 append ind \t
  1779.                 set fillColumn [expr $oldfillColumn - $tab * [string length $ind]]
  1780.             }
  1781.             if {$cr == 0} {
  1782.                 append text \r
  1783.                 incr cr
  1784.                 if {$cr == 1 && $bla >= 0} {append text $ind}
  1785.             }
  1786.             if {$bla >= 0 && $cr < 2} {append text \r; incr cr}
  1787.             set tmp ""
  1788.         }
  1789.     }
  1790.     # Add what's left
  1791.     if {$tmp != "" || $pos < $endPos} {
  1792.         if {$pos < $endPos} {append tmp [getText $pos $endPos]}
  1793.         regsub -all "\[ \t\]*\r\[ \t\]*" [string trim $tmp] " " tmp
  1794.         set tmp [string trimright [breakIntoLines $tmp]]
  1795.         regsub -all "" $tmp " " tmp
  1796.         regsub -all "\r" $tmp "\r$ind" tmp
  1797.         if {![htmlIsWhite $tmp]} {append text $ind}
  1798.         append text $tmp
  1799.         if {![htmlIsWhite $tmp]} {append text \r}
  1800.     }
  1801.     replaceText $startPos $endPos $text
  1802.     set fillColumn $oldfillColumn
  1803.     # Go back to previous position.
  1804.     if { $remember_str != "" } {
  1805.         regexp -indices $remember_str [getText $startPos [set end [getPos]]] wholematch
  1806.         set p [expr [info exists wholematch] ? [expr $startPos + 1 + [lindex $wholematch 1]] : $end]
  1807.         goto [expr $p >= $end ? $end -1 : $p]
  1808.     }
  1809. }
  1810.